home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / ASM / STDIO.ASM < prev    next >
Encoding:
Assembly Source File  |  1993-01-25  |  14.1 KB  |  551 lines
  1. ;* STDIO.ASM
  2. ;************************************************************************
  3. ;*                                    *
  4. ;*        PC Scheme/Geneva 4.00 Borland TASM code            *
  5. ;*                                    *
  6. ;* (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7. ;* (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8. ;*                                    *
  9. ;*----------------------------------------------------------------------*
  10. ;*                                    *
  11. ;*        Standard Input-Output (interpreter support)        *
  12. ;*                                    *
  13. ;*----------------------------------------------------------------------*
  14. ;*                                    *
  15. ;* Created by: John Jensen        Date: 1985            *
  16. ;* Revision history:                            *
  17. ;* - 21 Nov 86:    Detect disk full error correctly (rb)            *
  18. ;* - 7 Jan 87:    Added support for random I/O (dbs)            *
  19. ;* - 10 Feb 87:    EOF-DISP modified to reflect changes in page 5=syms (tc)*
  20. ;* - 16 Mar 87:    Added Binary I/O, Error handling for Disk Full (tc)    *
  21. ;* - 21 Jan 88:    binary I/O uses line-length=0 (rb)            *
  22. ;* - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  23. ;* - 8 Jan 93:  Whole window read interface moved to C (input.c) (mv)    *
  24. ;*                                    *
  25. ;*                    ``In nomine omnipotentii dei''    *
  26. ;************************************************************************
  27. IDEAL
  28. %PAGESIZE    60, 132
  29. MODEL    medium
  30. LOCALS    @@
  31.  
  32.     INCLUDE    "scheme.ash"
  33.  
  34. DATASEG
  35.  
  36. prn_handle DW    0             ; printer handle
  37. handlee    DW    0             ; handle
  38. pflags    DW    0             ; port flags
  39. nlines    DW    0             ; n_lines
  40. ncols    DW    0             ; n_cols
  41. ulline    DW    0             ; ul_line
  42. ulcol    DW    0             ; ul_col
  43. curline    DW    0             ; cur_line
  44. curcol    DW    0             ; cur_col
  45. t_attrib DW    0             ; text attribute
  46. insert_m DW    1             ; insert mode (1 = on, 0 = off)
  47. index    DW    0             ; index of buffer
  48. vidmode DW    0            ; detected video mode
  49.  
  50. CODESEG
  51.  
  52. ;********************************************************************
  53. ;                                                                   *
  54. ;     set_pos will set the file position, determing which chunk     *
  55. ;     of the file to read and then setting the file position to     *
  56. ;     the appropriate place.                                        *
  57. ;                                                                   *
  58. ;********************************************************************
  59. PROC C    set_pos USES di, @@port, @@amt, @@buffer
  60.     mov    ax, 1
  61.     call    get_port C, [@@port], ax ; get port address
  62.     mov    bx, [tmp_reg.page]
  63.     cmp    [ptype+bx], PORTTYPE
  64.     je    @@goodport
  65. @@error:
  66.     lea    bx, [@@msg]
  67. DATASEG
  68. @@msg    DB    "SET-FILE-POSITION!", 0
  69. CODESEG
  70.     mov    ax, 3
  71.     call    set_src_error C, bx, ax, [@@port], [@@amt], [@@buffer]
  72.     mov    ax, -1
  73.     jmp    @@return
  74.  
  75. @@goodport:
  76.     mov    bx, [tmp_reg.page]
  77.     ldpage    es, bx         ; get page address of port
  78.     mov    si, [tmp_reg.disp]
  79.     mov    dx, [(PORTDEF es:si).pflags]
  80.     and    dx, PORT_TYPE
  81.     jz    @@error
  82.     mov    di, [@@amt]
  83.     mov    dx, [di]
  84.     inc    dx
  85.     mov    [(PORTDEF es:si).chunk], dx    ; update chunk #
  86.     dec    dx
  87.     xor    bx, bx
  88.     xchg    bl, dh
  89.     xchg    dh, dl
  90.     mov    cx, bx
  91.     test    [(PORTDEF es:si).pflags], WRITE_MODE
  92.     pushf
  93.     jz    @@readonly
  94.     and    [(PORTDEF es:si).pflags], NOT PORT_FLUSHED ; clear flushed bit
  95.     mov    bx, [@@buffer]
  96.     add    dx, [bx]         ; add file position to chunk offset
  97. @@readonly:
  98.     mov    bx, [(PORTDEF es:si).handle]
  99.     mov    ax, 4200h         ; move file pointer to offset dx
  100.     int    MSDOS
  101.     popf
  102.     jnz    @@output         ; jump if output port
  103.  
  104.     push    ds es
  105.     pop    ds
  106.     mov    cx, 256         ; get buffer length
  107.     mov    bx, [(PORTDEF ds:si).handle]
  108.     lea    dx, [(PORTDEF ds:si).buffer]
  109.     mov    ah, 3fh
  110.     int    MSDOS           ; read from a file
  111.     pop    ds
  112.     mov    [(PORTDEF es:si).bufend], ax    ; save # bytes read
  113. @@output:
  114.     mov    bx, [@@buffer]         ; get offset of chunk offset
  115.     mov    ax, [bx]
  116.     mov    [(PORTDEF es:si).bufpos], ax    ; and save in port
  117. @@return:
  118.     ret
  119. ENDP    set_pos
  120.  
  121. ;**************************************************************************
  122. ;                     Set Port Address
  123. ;**************************************************************************
  124. PROC C    ssetadr USES si di bx, @@page:WORD, @@disp:WORD
  125.     mov    bx, [@@page]
  126.     cmp    [ptype+bx], PORTTYPE
  127.     je    @@goodport
  128.     lea    si, [@@msg]
  129. DATASEG
  130. @@msg    DB    "[VM INTERNAL ERROR] setadr: bad port", CR, LF, 0
  131. CODESEG
  132.     call    zprintf C, si
  133.     call    force_debug C
  134.     mov    ax, 1             ; return error status
  135.     jmp    @@return
  136.  
  137. @@goodport:
  138.     mov    [port_reg.page], bx
  139.     mov    si, [@@disp]
  140.     mov    [port_reg.disp], si
  141.     ldpage    es, bx
  142.     mov    ax, [(PORTDEF es:si).handle]
  143.     mov    [handlee], ax
  144.     mov    ax, [(PORTDEF es:si).pflags]
  145.     mov    [pflags], ax
  146.     xor    ax, ax             ; return status
  147. @@return:
  148.     ret
  149. ENDP    ssetadr
  150.  
  151. ;**************************************************************************
  152. ;                  Input a Single Character
  153. ;**************************************************************************
  154. PROC C    take_ch USES si di
  155.     LOCAL     @@leng:WORD, @@buffer:BYTE:BUFFSIZE, @@newbufpos:WORD
  156.     mov    [@@newbufpos], 0
  157.     mov    [@@leng], BUFFSIZE
  158.     mov    bx, [port_reg.page]
  159.     ldpage    es, bx
  160.     mov    si, [port_reg.disp]
  161.  
  162.     test    [(PORTDEF es:si).pflags], WRITE_MODE
  163.     jz    @@readonly
  164.     mov    bx, [(PORTDEF es:si).pflags]
  165.     and    bx, PORT_FLUSHED+PORT_TYPE    ;isolate appropriate flags
  166.     cmp    bx, TYPE_FILE            ;buffer modified?
  167.     jne    @@readonly
  168.     or    [(PORTDEF es:si).pflags], PORT_FLUSHED ;clear flag
  169.  
  170. ; this read was preceded by at least one write, so reposition file pointer
  171. ; so it rereads the buffer
  172.     mov    bx, [(PORTDEF es:si).handle]
  173.     dec    [(PORTDEF es:si).chunk]
  174.     mov    cx, [(PORTDEF es:si).chunk]
  175.     xor    dx, dx
  176.     xchg    dh, cl
  177.     xchg    cl, ch
  178.     mov    ax, 4200h         ; reposition file pointer
  179.     push    si
  180.     int    MSDOS
  181.     pop    si
  182.     mov    bx, [(PORTDEF es:si).bufpos]
  183.     mov    [@@newbufpos], bx     ; restore current buffer position
  184.     jmp    @@fromfile
  185.  
  186. @@readonly:
  187.     mov    bx, [(PORTDEF es:si).bufpos]
  188.     cmp    bx, [(PORTDEF es:si).bufend]
  189.     jge    @@bufferempty
  190.     jmp    @@getnext
  191.  
  192. @@bufferempty:
  193.     test    [pflags], TYPE_SOFTWARE    ; file object ?
  194.     jz    @@notfromfile
  195.     jmp    @@fromfile
  196.  
  197. @@notfromfile:
  198.     test    [pflags], TYPE_STRING         ; read from string?
  199.     jz    @@fromwindow
  200. @@fromstring:
  201.     lea    ax, [@@leng]
  202.     lea    bx, [@@buffer]
  203.     call    stringrd C, [port_reg.page], [port_reg.disp], bx, ax
  204.     test    ax, ax             ; check return status
  205.     jnz    @@error
  206.     mov    bx, [port_reg.page]
  207.     ldpage    es, bx
  208.     mov    si, [port_reg.disp]
  209. @@readchar:
  210.     mov    bx, [@@leng]
  211.     jmp    @@lengthset
  212.  
  213. @@error:
  214.     lea    bx, [@@msg]
  215. DATASEG
  216. @@msg    DB    "[VM INTERNAL ERROR] takechar: source not a string", CR, LF, 0
  217. CODESEG
  218.     call    zprintf C, bx        ; display error message
  219.     jmp    @@readchar
  220.  
  221. @@fromwindow:                ; read from window
  222.     call    read_win C
  223.     mov    bx, [port_reg.page]
  224.     ldpage    es, bx
  225.     mov    si, [port_reg.disp]
  226.     mov    bx, ax
  227. @@lengthset:
  228.     mov    [(PORTDEF es:si).bufend], bx ; save buffer length
  229.     or    bx, bx
  230.     jnz    @@buffergood
  231.     mov    [(PORTDEF es:si).bufpos], bx
  232.     jmp    @@sendeof
  233. @@buffergood:
  234.     test    [pflags], TYPE_SOFTWARE    ; file object ?
  235.     jnz    @@notwindow
  236.     test    [pflags], TYPE_STRING      ; or string ?
  237.     jz    @@getfirst
  238. @@notwindow:                ; then copy chars from buffer
  239.     push    si
  240.     lea    di, [(PORTDEF si).buffer]
  241.     lea    si, [@@buffer]
  242.     mov    cx, bx             ; length of characters to move
  243.     cld                ; direction forward
  244.     rep    movsb
  245.     pop    si
  246. @@getfirst:
  247.     mov    bx, [@@newbufpos]
  248. @@getnext:                ; get the next char from input buffer
  249.     xor    ah, ah
  250.     mov    al, [(PORTDEF es:si+bx).buffer]
  251.     inc    bx
  252.     mov    [(PORTDEF es:si).bufpos], bx
  253.     cmp    al, CTRL_Z         ; test for End-of-File
  254.     jne    @@return
  255.     test    [pflags], PORT_BINARY
  256.     jnz    @@return
  257. @@sendeof:
  258.     mov    ax, 256         ; text file, send EOF
  259. @@return:
  260.     ret
  261.  
  262. @@fromfile:
  263.     cmp    [(PORTDEF es:si).chunk], 1 ; operating on first chunk ?
  264.     jne    @@notfirst
  265.     cmp    [(PORTDEF es:si).bufpos], 0 ; buffer filled ?
  266.     je    @@bufferfilled
  267. @@notfirst:
  268.     inc    [(PORTDEF es:si).chunk] ; bump the chunk number
  269. @@bufferfilled:
  270.     mov    bx, [handlee]
  271.     lea    cx, [@@leng]         ; address of length of bytes to read
  272.     lea    ax, [@@buffer]         ; input buffer
  273.     call    zread C, bx, ax, cx
  274.     or    ax, ax
  275.     jnz    @@doserror
  276.     jmp    @@readchar
  277.  
  278. @@doserror:
  279.     add    ax, (IO_ERRORS_START - 1) ; Make Dos I/O error number
  280.     mov    bx, 1
  281.     lea    cx, [port_reg]
  282.     call    dos_error C, bx, ax, cx    ; invoke scheme error handler
  283. ENDP    take_ch
  284.  
  285. ;****************************************************************
  286. ;            Output a single character
  287. ;****************************************************************
  288. PROC C    givechar USES si di bx cx dx, @@char:WORD
  289.     LOCAL    @@length, @@vidmode
  290.     mov    [@@vidmode], -1
  291.     cmp    [trns_reg.page], 0     ; transcript file?
  292.     jz    @@notrans
  293.     mov    bx, [port_reg.page]
  294.     mov    si, [port_reg.disp]
  295.     ldpage    es, bx
  296.     test    [(PORTDEF es:si).flags], W_TRANS
  297.     jz    @@notrans
  298.     push    bx
  299.     call    ssetadr C, [trns_reg.page], [trns_reg.disp]
  300.     call    givechar C, [@@char]    ; output to transcript file
  301.     pop    bx
  302.     call    ssetadr C, bx, si
  303. @@notrans:
  304.     mov    cx, [@@char]
  305.     test    [pflags], TYPE_SOFTWARE ; window ?
  306.     jz    @@towindow
  307.     jmp    @@tofile
  308. @@towindow:
  309.     test    [pflags], TYPE_STRING     ; string ?
  310.     jz    @@@@notstring
  311.     jmp    @@return
  312. @@@@notstring:
  313.  
  314. ;********************************************************************
  315. ;                     Output Character to Window
  316. ;
  317. ; Description:This routine writes a character to the current cursor
  318. ;             position, then increments the cursor location.
  319. ;             If the current cursor position is now within the bounds
  320. ;             of the window, the character is output in the first
  321. ;             column of the next line, scrolling the window, if
  322. ;             necessary.  The current text attributes are used to
  323. ;             write the character.
  324. ; Note: cx = character
  325. ;********************************************************************
  326.     mov    bx, [port_reg.page]
  327.     mov    si, [port_reg.disp]
  328.     ldpage    es, bx
  329.     test    [pflags], WRITE_MODE    ; get the port flag
  330.     jnz    @@open
  331.     jmp    @@return
  332. @@open:
  333.     mov    bx, [(PORTDEF es:si).curline]
  334.     mov    ax, [(PORTDEF es:si).curcol]
  335.     mov    dx, [(PORTDEF es:si).ulline]
  336.     mov    [ulline], dx
  337.     mov    dx, [(PORTDEF es:si).ulcol]
  338.     mov    [ulcol], dx
  339.     mov    dx, [(PORTDEF es:si).nlines]
  340.     mov    [nlines], dx
  341.     mov    dx, [(PORTDEF es:si).ncols]
  342.     mov    [ncols], dx
  343.     mov    dx, [(PORTDEF es:si).text]
  344.     mov    [t_attrib], dx
  345. @@null:                    ; Check for the character
  346.     or    cl, cl
  347.     jnz    @@backspace
  348.     jmp    @@return         ; do nothing
  349.  
  350. @@backspace:
  351.     cmp    cl, BACKSPACE         ; backspace?
  352.     jne    @@bell
  353.     dec    ax
  354.     or    ax, ax
  355.     jl    @@backempty
  356.     jmp    @@updatecol
  357. @@backempty:
  358.     xor    ax, ax             ; cur_col = 0
  359.     jmp    @@updatecol
  360.  
  361. @@bell:
  362.     cmp    cl, BELL         ; bell character?
  363.     jne    @@tab
  364.     call    zbell C            ; sound the alarm
  365.     jmp    @@return
  366.  
  367. @@tab:
  368.     cmp    cl, TAB         ; tab character?
  369.     jne    @@linefeed
  370.     mov    cx, ax
  371.     mov    dx, 8             ; dl = 8
  372.     div    dl             ; ah = (cur_col % 8)
  373.     sub    dl, ah
  374.     add    cx, dx
  375.     mov    ax, cx
  376.     jmp    @@updatecol
  377.  
  378. @@linefeed:
  379.     cmp    cl, LF             ; line feed?
  380.     jne    @@carriage
  381.     xor    ax, ax
  382.     inc    bx
  383.     cmp    bx, [nlines]         ; out of lines?
  384.     jge    @@scroll
  385.     jmp    @@updateline
  386. @@scroll:
  387.     call    zscroll C, [ulline], [ulcol], [nlines], [ncols], [t_attrib]
  388.     mov    bx, [nlines]
  389.     dec    bx
  390.     xor    ax, ax
  391.     jmp    @@updateline
  392.  
  393. @@carriage:
  394.     cmp    cl, CR
  395.     jne    @@allchars
  396.     xor    ax, ax            ; return the carriage back home
  397.     jmp    @@updatecol
  398.  
  399. @@clip:                    ; Support for @@allchars
  400.     inc    ax
  401.     jmp    @@updatecol
  402.  
  403. @@allchars:
  404.     cmp    ax, [ncols]         ; check end of line
  405.     jl    @@checkline
  406.     mov    dx, [(PORTDEF es:si).flags]
  407.     and    dx, W_WRAP
  408.     jz    @@clip
  409.     inc    bx             ; wrap
  410.     xor    ax, ax
  411. @@checkline:
  412.     cmp    bx, [nlines]         ; check out of lines?
  413.     jl    @@displaychar
  414.     call    zscroll C, [ulline], [ulcol], [nlines], [ncols], [t_attrib]
  415.     mov    bx, [nlines]
  416.     dec    bx             ; set up current line number
  417.     xor    ax, ax             ; and current column number
  418. @@displaychar:
  419.     mov    [curcol], ax
  420.     mov    [curline], bx
  421.     add    ax, [ulcol]
  422.     add    bx, [ulline]
  423.     mov    dl, [BYTE @@char]
  424.     mov    dh, [BYTE t_attrib]
  425.     mov    [@@length], 1
  426.     lea    cx, [@@vidmode]
  427.     call    zputc C, bx, ax, dx, [@@length], cx
  428.     mov    ax, [curcol]
  429.     mov    bx, [curline]
  430.     inc    ax             ; increment current column
  431. @@updateline:
  432.     mov    [(PORTDEF es:si).curline], bx
  433. @@updatecol:
  434.     mov    [(PORTDEF es:si).curcol], ax
  435.     jmp    @@return
  436.  
  437. ;************************************************************************
  438. ;            Output character to file
  439. ;************************************************************************
  440. @@tofile:
  441.     lea    bx, [@@length]         ; zwrite needs length = (int *)
  442.     mov    [WORD bx], 1
  443.     lea    si, [@@char]
  444.     mov    ax, [handlee]
  445.     test    [pflags], PORT_BINARY
  446.     jnz    @@outputchar
  447.     cmp    cl, LF            ; line-feed ?
  448.     jne    @@outputchar
  449.     mov    [WORD si], CR        ; then output carriage return
  450.     jmp    @@outputchar
  451.  
  452. @@outputchar:
  453.     call    zwrite C, ax, si, bx
  454.     or    ax, ax
  455.     jnz    @@error
  456.     cmp    [@@length], 1
  457.     jne    @@diskfull
  458.     test    [pflags], PORT_BINARY    ; Binary file ?
  459.     jnz    @@handlechar
  460.     cmp    [WORD si], CR         ; carriage return ?
  461.     jne    @@handlechar
  462.     mov    ax, [handlee]
  463.     lea    si, [@@char]
  464.     mov    [WORD si], LF        ; then add a line feed
  465.     lea    bx, [@@length]
  466.     call    zwrite C, ax, si, bx
  467.     test    ax, ax             ; check return status
  468.     jnz    @@error
  469.     cmp    [@@length], 1
  470.     je    @@handlechar
  471. @@diskfull:
  472.     mov    ax, DISK_FULL_ERROR     ; Note disk full error
  473.     jmp    @@doserror
  474.  
  475. @@error:
  476.     add    ax, (IO_ERRORS_START - 1) ; make dos i/o error number
  477. @@doserror:
  478.     mov    bx, 1             ; 1 = unreturnable
  479.     lea    cx, [port_reg]
  480.     call    dos_error C, bx, ax, cx    ; invoke scheme error handler
  481.  
  482. @@handlechar:
  483.     mov    bx, [port_reg.page]
  484.     ldpage    es, bx
  485.     mov    bx, [WORD si]        ; get the character
  486.     mov    si, [port_reg.disp]
  487.     mov    ax, [(PORTDEF es:si).curcol]
  488.     test    [pflags], PORT_BINARY     ; Binary file?
  489.     jnz    @@checkboundary
  490.     cmp    bl, BACKSPACE         ; back space?
  491.     jne    @@filetab
  492.     dec    ax
  493.     or    ax, ax
  494.     jge    @@checkboundary
  495. @@begofline:
  496.     xor    ax, ax
  497.     jmp    @@checkboundary
  498.  
  499. @@filetab:
  500.     cmp    bl, TAB         ; tab?
  501.     jne    @@fileCR
  502.     mov    cx, ax
  503.     mov    dx, 8
  504.     div    dl             ; ah = (cur_col % 8)
  505.     sub    dl, ah
  506.     add    cx, dx
  507.     mov    ax, cx
  508.     jmp    @@checkboundary
  509.  
  510. @@fileCR:
  511.     cmp    bl, CR             ; carriage return?
  512.     jne    @@fileLF
  513.     mov    bl, LF             ; yes, make it a linefeed
  514.     jmp    @@begofline
  515.  
  516. @@fileLF:
  517.     cmp    bl, LF             ; line feed?
  518.     jne    @@default
  519.     jmp    @@begofline
  520.  
  521. @@default:
  522.     cmp    ax, [(PORTDEF es:si).ncols]
  523.     jge    @@begofline
  524.     inc    ax
  525.  
  526. @@checkboundary:
  527.     cmp    [(PORTDEF es:si).ncols], 0
  528.     je    @@columnok
  529.     mov    [(PORTDEF es:si).curcol], ax
  530. @@columnok:
  531.     mov    ax, [(PORTDEF es:si).bufpos]
  532.     inc    ax
  533.     test    [pflags], PORT_BINARY     ; Binary file?
  534.     jnz    @@nobump
  535.     cmp    bx, LF             ; CR or LF just output?
  536.     jne    @@nobump
  537.     inc    ax             ; yes bump # bytes written
  538. @@nobump:
  539.     cmp    ax, 100h         ; Exceed chunk boundary?
  540.     jle    @@setbufpos
  541.     sub    ax, 100h         ; ax = excess above chunk
  542.     inc    [(PORTDEF es:si).chunk]
  543. @@setbufpos:
  544.     mov    [(PORTDEF es:si).bufpos], ax
  545. @@return:
  546.     xor    ax, ax
  547.     ret
  548. ENDP    givechar
  549.  
  550.     END
  551.